home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dll_gen / winfox / filever.wd_ / filever.wd
Text File  |  1995-01-31  |  11KB  |  359 lines
  1. VERSION 2.00
  2. Begin Form FileVer 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "File Version Information"
  6.    ClientHeight    =   5520
  7.    ClientLeft      =   1245
  8.    ClientTop       =   1140
  9.    ClientWidth     =   6990
  10.    ControlBox      =   0   'False
  11.    Height          =   5925
  12.    Left            =   1185
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   5520
  17.    ScaleWidth      =   6990
  18.    Top             =   795
  19.    Width           =   7110
  20.    Begin CommandButton CmdFileVersions 
  21.       BackColor       =   &H00C0C0C0&
  22.       Caption         =   "&View Version Info"
  23.       Height          =   375
  24.       Left            =   960
  25.       TabIndex        =   0
  26.       Top             =   4440
  27.       Width           =   5055
  28.    End
  29.    Begin TextBox Text1 
  30.       Height          =   285
  31.       Left            =   360
  32.       MaxLength       =   64
  33.       TabIndex        =   2
  34.       Text            =   "Text1"
  35.       Top             =   1080
  36.       Width           =   3015
  37.    End
  38.    Begin FileListBox File1 
  39.       Height          =   225
  40.       Hidden          =   -1  'True
  41.       Left            =   4920
  42.       Pattern         =   "*.DLL;*.DRV;*.EXE;*.OCX;*.VBX"
  43.       System          =   -1  'True
  44.       TabIndex        =   6
  45.       Top             =   3720
  46.       Visible         =   0   'False
  47.       Width           =   1575
  48.    End
  49.    Begin DirListBox Dir1 
  50.       Height          =   1155
  51.       Left            =   3600
  52.       TabIndex        =   3
  53.       Top             =   240
  54.       Width           =   3015
  55.    End
  56.    Begin DriveListBox Drive1 
  57.       Height          =   315
  58.       Left            =   360
  59.       TabIndex        =   4
  60.       Top             =   240
  61.       Width           =   3015
  62.    End
  63.    Begin ListBox FileList 
  64.       FontBold        =   0   'False
  65.       FontItalic      =   0   'False
  66.       FontName        =   "Fixedsys"
  67.       FontSize        =   9
  68.       FontStrikethru  =   0   'False
  69.       FontUnderline   =   0   'False
  70.       Height          =   1605
  71.       Left            =   360
  72.       Sorted          =   -1  'True
  73.       TabIndex        =   5
  74.       Top             =   2460
  75.       Width           =   6255
  76.    End
  77.    Begin CommandButton CmdOkay 
  78.       BackColor       =   &H00C0C0C0&
  79.       Cancel          =   -1  'True
  80.       Caption         =   "O &K A Y"
  81.       Height          =   375
  82.       Left            =   960
  83.       TabIndex        =   1
  84.       Top             =   4800
  85.       Width           =   5055
  86.    End
  87.    Begin Label LblFileCount 
  88.       Alignment       =   2  'Center
  89.       BackColor       =   &H00C0C0C0&
  90.       Caption         =   "Label2"
  91.       ForeColor       =   &H00800000&
  92.       Height          =   195
  93.       Left            =   2040
  94.       TabIndex        =   9
  95.       Top             =   1920
  96.       Width           =   2895
  97.    End
  98.    Begin Label LblFullPath 
  99.       Alignment       =   2  'Center
  100.       BackColor       =   &H00C0C0C0&
  101.       Caption         =   "Label2"
  102.       Height          =   195
  103.       Left            =   360
  104.       TabIndex        =   8
  105.       Top             =   1560
  106.       Width           =   6255
  107.    End
  108.    Begin Label Label1 
  109.       BackStyle       =   0  'Transparent
  110.       Caption         =   "Search Specification:"
  111.       ForeColor       =   &H00800000&
  112.       Height          =   195
  113.       Left            =   360
  114.       TabIndex        =   7
  115.       Top             =   840
  116.       Width           =   3015
  117.    End
  118. End
  119. 'file list box allow multiple selections
  120.  
  121. Dim PathWord As String
  122. Dim FileSpec As String
  123.  
  124. Sub CmdFileVersions_Click ()
  125.     If FileList.ListIndex = -1 Then
  126.         MsgBox "No file selected to view!", 16, "Version Info"
  127.         Exit Sub
  128.         End If
  129.  
  130.     ThisFile = FileList.List(FileList.ListIndex)
  131.     pos% = InStr(ThisFile, Chr$(9))
  132.     ThisFile = Left$(ThisFile, pos% - 1)
  133.     FullPath = dir1.Path
  134.     FullPath = BackSlashAdd(FullPath) + ThisFile
  135.     
  136.     TheVersion = GetFileVersion(FullPath, "FileVersion")
  137.     If TheVersion = "" Then
  138.         msg$ = Chr$(34) + FullPath + Chr$(34) + nl + nl
  139.         msg$ = msg$ + "This file has no version stamping."
  140.         MsgBox msg$, 48, "Version Info"
  141.         Exit Sub
  142.         End If
  143.  
  144.     Screen.MousePointer = 11
  145.     Comments = GetFileVersion(FullPath, "Comments")
  146.     CompanyName = GetFileVersion(FullPath, "CompanyName")
  147.     FileDescription = GetFileVersion(FullPath, "FileDescription")
  148.     InternalName = GetFileVersion(FullPath, "InternalName")
  149.     LegalCopyright = GetFileVersion(FullPath, "LegalCopyright")
  150.     LegalTrademarks = GetFileVersion(FullPath, "LegalTrademarks")
  151.     OriginalFilename = GetFileVersion(FullPath, "OriginalFilename")
  152.     PrivateBuild = GetFileVersion(FullPath, "PrivateBuild")
  153.     ProductName = GetFileVersion(FullPath, "ProductName")
  154.     ProductVersion = GetFileVersion(FullPath, "ProductVersion")
  155.     SpecialBuild = GetFileVersion(FullPath, "SpecialBuild")
  156.     
  157.     msg$ = "File Version:" + Chr$(9) + TheVersion + nl
  158.     msg$ = msg$ + "Comments:" + Chr$(9) + Comments + nl
  159.     msg$ = msg$ + "Company Name:" + Chr$(9) + PathDotsRight(CompanyName, 28) + nl
  160.     msg$ = msg$ + "File Description:" + Chr$(9) + PathDotsRight(FileDescription, 28) + nl
  161.     msg$ = msg$ + "Internal Name:" + Chr$(9) + InternalName + nl
  162.     msg$ = msg$ + "Legal Copyright:" + Chr$(9) + PathDotsRight(LegalCopyright, 28) + nl
  163.     msg$ = msg$ + "Legal Trademarks:" + Chr$(9) + PathDotsRight(LegalTrademarks, 28) + nl
  164.     msg$ = msg$ + "OriginalFileName:" + Chr$(9) + OriginalFilename + nl
  165.     msg$ = msg$ + "Private Build:" + Chr$(9) + PrivateBuild + nl
  166.     msg$ = msg$ + "Product Name:" + Chr$(9) + PathDotsRight(ProductName, 28) + nl
  167.     msg$ = msg$ + "Product Version:" + Chr$(9) + ProductVersion + nl
  168.     msg$ = msg$ + "Special Build:" + Chr$(9) + SpecialBuild
  169.  
  170.     Screen.MousePointer = 0
  171.     MsgBox msg$, 48, FullPath
  172. End Sub
  173.  
  174. Sub CmdOkay_Click ()
  175.     Unload Me
  176. End Sub
  177.  
  178. Sub Dir1_Change ()
  179.     Screen.MousePointer = 11
  180.     ChDir dir1.Path
  181.     LblFullPath.Caption = PathWord + LCase$(dir1.Path)
  182.     File1.Path = dir1.Path
  183.     DoFileList
  184.     Screen.MousePointer = 0
  185. End Sub
  186.  
  187. Sub DoFileList ()
  188.     Screen.MousePointer = 11
  189.     On Error GoTo BadFileSpec
  190.     File1.Pattern = FileSpec
  191.     FileList.Clear
  192.     NbrFound% = File1.ListCount
  193.     If NbrFound% = 0 Then
  194.         FileWord$ = "No Matching Files Found"
  195.         ElseIf NbrFound% = 1 Then FileWord$ = "One Matching File Found"
  196.         Else
  197.         FileWord$ = Format$(NbrFound%, "###,##0") + " Matching Files Found"
  198.         End If
  199.     LblFileCount.Caption = FileWord$
  200.     If File1.ListCount = 0 Then
  201.         Screen.MousePointer = 0
  202.         Exit Sub
  203.         Else
  204.         For i = 0 To File1.ListCount - 1
  205.             TheFileName$ = File1.List(i)
  206.             FullPath$ = CurDir$
  207.             FullPath$ = BackSlashAdd(FullPath$) + TheFileName$
  208.             TimeStamp$ = FileDateTime(FullPath$)
  209.             TheFileDate$ = Format$(TimeStamp$, "dd mmm yyyy")
  210.             If Left$(TheFileDate$, 1) = "0" Then
  211.                 TheFileDate$ = " " + Right$(TheFileDate$, Len(TheFileDate$) - 1)
  212.                 End If
  213.             TheFileTime$ = Format$(TimeStamp$, "hh:mm am/pm")
  214.             If Left$(TheFileTime$, 1) = "0" Then
  215.                 TheFileTime$ = " " + Right$(TheFileTime$, Len(TheFileTime$) - 1)
  216.                 End If
  217.             TheFileSize$ = Format$(FileLen(FullPath$), "###,###,##0")
  218.             If Len(TheFileSize$) < 11 Then
  219.                 AddSpace$ = Space$(11 - Len(TheFileSize$))
  220.                 Else
  221.                 AddSpace$ = ""
  222.                 End If
  223.             TheFileSize$ = AddSpace$ + TheFileSize$
  224.             TheFileAttr% = GetAttr(FullPath$)
  225.             TheAttr$ = ""
  226.             If (TheFileAttr% And 32) <> 0 Then
  227.                 TheAttr$ = TheAttr$ + "A"
  228.                 Else
  229.                 TheAttr$ = TheAttr$ + "-"
  230.                 End If
  231.             If (TheFileAttr% And 4) <> 0 Then
  232.                 TheAttr$ = TheAttr$ + "S"
  233.                 Else
  234.                 TheAttr$ = TheAttr$ + "-"
  235.                 End If
  236.             If (TheFileAttr% And 2) <> 0 Then
  237.                 TheAttr$ = TheAttr$ + "H"
  238.                 Else
  239.                 TheAttr$ = TheAttr$ + "-"
  240.                 End If
  241.             If (TheFileAttr% And 1) <> 0 Then
  242.                 TheAttr$ = TheAttr$ + "R"
  243.                 Else
  244.                 TheAttr$ = TheAttr$ + "-"
  245.                 End If
  246.             FileList.AddItem TheFileName$ + Chr$(9) + TheFileDate$ + Chr$(9) + TheFileTime$ + Chr$(9) + TheAttr$ + Chr$(9) + TheFileSize$
  247.             Next i
  248.         End If
  249.     Screen.MousePointer = 0
  250.     Exit Sub
  251. BadFileSpec:
  252.     Screen.MousePointer = 0
  253.     Beep
  254.     MsgBox "Invalid File Specification!", 16, "Data Entry Error"
  255.     Text1.SetFocus
  256.     Exit Sub
  257. End Sub
  258.  
  259. Sub Drive1_Change ()
  260.     On Error GoTo SelDrvBad
  261.     Screen.MousePointer = 11
  262.     ChDrive Drive1.Drive
  263.     dir1.Path = Drive1.Drive
  264.     Screen.MousePointer = 0
  265.     Exit Sub
  266. SelDrvBad:
  267.     Screen.MousePointer = 0
  268.     msg$ = "Drive Error " + UCase$(Left$(Drive1.Drive, 1)) + ":"
  269.     response = MsgBox("Can NOT Access Drive!", 21, msg$)
  270.     If response = 4 Then
  271.         Screen.MousePointer = 11
  272.         Resume 0
  273.         End If
  274.     WinRoot
  275.     Exit Sub
  276. End Sub
  277.  
  278. Sub FileList_DblClick ()
  279.     CmdFileVersions_Click
  280. End Sub
  281.  
  282. Sub Form_Load ()
  283.     FormCenterScreen Me
  284.     PathWord = "Full Path = "
  285.     
  286.     On Error GoTo BadDrive3
  287.     LblFullPath.Caption = PathWord + LCase$(CurDir$)
  288.     
  289.     ListHscroll FileList, 40
  290.     ReDim tabsets%(4)
  291.     tabsets%(0) = 0
  292.     tabsets%(1) = 16 * 4
  293.     tabsets%(2) = 30 * 4
  294.     tabsets%(3) = 42 * 4
  295.     tabsets%(4) = 44 * 4
  296.     dummy% = OutMessage(FileList.hWnd, 1043, 5, tabsets%(0))
  297.     FileSpec = "*.DLL;*.DRV;*.EXE;*.OCX;*.VBX"
  298.     Text1.Text = FileSpec
  299.     DoFileList
  300.  
  301.     Screen.MousePointer = 0
  302.     Exit Sub
  303. BadDrive3:
  304.     WinRoot
  305.     Resume Next
  306. End Sub
  307.  
  308. Sub Form_Paint ()
  309.     DoForm3D Me, "raised", 2, 0
  310.     DoForm3D Me, "sunken", 2, 2
  311.     
  312.     DoControl3D Drive1, "sunken", 1
  313.     DoControl3D dir1, "sunken", 1
  314.     DoControl3D Text1, "sunken", 1
  315.     DoControl3D FileList, "sunken", 1
  316.  
  317.     DoControl3D LblFullPath, "sunken", 1
  318.     DoControl3D LblFileCount, "sunken", 1
  319. End Sub
  320.  
  321. Sub Text1_GotFocus ()
  322.     Text1.SelStart = 0
  323.     Text1.SelLength = Len(Text1.Text)
  324. End Sub
  325.  
  326. Sub Text1_KeyPress (KeyAscii As Integer)
  327.     char = Chr(KeyAscii)
  328.     KeyAscii = Asc(UCase(char))
  329.     If char = "\" Then KeyAscii = 0
  330.     If char = Chr$(34) Then KeyAscii = 0
  331.     If char = Chr$(32) Then KeyAscii = 0
  332.     If char = ":" Then KeyAscii = 0
  333.     If char = Chr$(13) Then
  334.         KeyAscii = 0
  335.         SendKeys "{TAB}"
  336.         Exit Sub
  337.         End If
  338. End Sub
  339.  
  340. Sub Text1_LostFocus ()
  341.     FileSpec = Text1.Text
  342.     DoFileList
  343. End Sub
  344.  
  345. Sub WinRoot ()
  346.     Screen.MousePointer = 11
  347.     ReturnString$ = Space$(255)
  348.     ChDrive "c:"
  349.     ret% = GetPath("Windows", ReturnString$)
  350.     WinDir$ = TrimAtNull(ReturnString$)
  351.     WinDir$ = Left$(WinDir$, 3)
  352.     Drive1.Drive = WinDir$
  353.     ChDrive WinDir$
  354.     dir1.Path = CurDir$
  355.     LblFullPath.Caption = PathWord + LCase$(dir1.Path)
  356.     Screen.MousePointer = 0
  357. End Sub
  358.  
  359.